home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / stayres.pqs / stayres.pas
Pascal/Delphi Source File  |  1985-06-26  |  43KB  |  984 lines
  1.  
  2. {$C-}
  3. {-----------------------------------------------------------------------------}
  4. {                                                                             }
  5. {                                                                             }
  6. {                                                                             }
  7. {         "  S o r r y ,  D a v e,   I   C a n ' t   D o   T h a t .  "       }
  8. {                                                                             }
  9. {                                                                             }
  10. {                                                          Arthur C. Clark    }
  11. {                                                           " 2 0 0 1 "       }
  12. {-----------------------------------------------------------------------------}
  13.  
  14. {  A  Turbo  "stay-resident" program clobbers the Dos register stack.  It
  15.   jumps over the Turbo run-time initialization code that would set up the
  16.   program registers  and environment.   Secondly,  a  stay-resident  program
  17.   could not ordinarily issue file I/O since that would clobber Dos interrupt
  18.   registers.  Therefore,  the following code proposes an inline solution,
  19.   providing a Turbo entry  stack  for  "stay-resident"  programs  and allowing
  20.   those programs to issue Dos I/O and other interrupts.
  21.  
  22.    This Turbo stay-resident demo has been put together to perform both Dos I/O
  23.    and Bios interrupts. It has also been tested for re-entrancy and
  24.    recursiveness on an IBM PC with PCDos .
  25.  
  26.     Separate the include files, compile to a COM file and execute with the
  27.     Alt-F10 key. It will also free its memory and return to Dos with the
  28.     Ctrl-Home key at the "Press a key" prompt. (Illustrated in the Stayxit
  29.     file). Maximum free dynamic memory should be between A40-B00 since this
  30.     demo uses a recursive stack.
  31.  
  32.                                                  The Hunters Helper
  33.  
  34.                                                   L.Ferris
  35.                                                   4268 26th St
  36.                                                   San Francisco,Ca. 94131
  37.                                                   [ 70357,2716 ]      }
  38. {-----------------------------------------------------------------------------}
  39. {     This code has been tested/used on an IBM PC using PC-DOS 2.10           }
  40. {-----------------------------------------------------------------------------}
  41.  
  42.  
  43. { Authors: Lane H. Ferris (Stay Resident Code)
  44.            Neil J. Rubenking (Directory code and ideas)
  45.            Jim Everingham (The Window Manager/Editor)
  46.            Other Public Gurus on whose shoulders we stand.
  47.  
  48. { PURPOSE:  This code will serve as a template to create other "Stay  Resident"
  49.             programs  in  Turbo  Pascal(tm).   This  code  intercepts  Int  16,
  50.             displacing original Interrupt  16  Vector  to  User  Interrupt  68.
  51.             During  execution  of  other  programs,  it  can  be invoked by the
  52.             special key combination  specified  by  "Our_Char"  (in  this  case
  53.             <Alt>-F10.)
  54. }
  55.  
  56. Program Stay_Resident;
  57.  
  58.   { * * * * * * * CONSTANTS * * * * * * * * * * * * * * * * * * * * * * }
  59.   const
  60.     Our_Char        =  113; {this is the scan code for AltF10}
  61.     Ctrl_Home       = #119; {Control Home Scan Code          }
  62.     Quit_Key        = #119;
  63.     Ctrl_End        = #117; {Control End Scan Code           }
  64.     User_Int        = $68; {place to put new interrupt}
  65.     Kybrd_Int       = $16; {BIOS keyboard interrupt}
  66.  
  67.   { - - - - - - - T Y P E    D E C L A R A T I O N S - - - - - - - - - - - -  }
  68.   Type
  69.     Regtype     = record Ax,Bx,Cx,Dx,Bp,Si,Di,Ds,Es,Flags:integer  end;
  70.     HalfRegtype = record Al,Ah,Bl,Bh,Cl,Ch,Dl,Dh:byte              end;
  71.     filename_type = string[64];
  72.  
  73.   { - - - - - - - T Y P E D   C O N S T A N T S - - - - - - - - - - - - - - -}
  74.   Const
  75.     {regs is defined as a typed constant in order to get it in the code segment}
  76.     Regs   : regtype = (Ax:0;Bx:0;Cx:0;Dx:0;Bp:0;Si:0;Di:0;Ds:0;Es:0;Flags:0);
  77.  
  78.       OurDseg: integer = 0;            {Our Data Segment Value             }
  79.       OurSseg: integer = 0;            {Our Stack Segment Value            }
  80.       DosSseg: integer = 0;            {Dos Stack Segment Value            }
  81.       Inuse  : Boolean = false;        {Recursion flag                     }
  82.  
  83.  { - - - - - - - V A R I A B L E S - - - - - - - - - - - - - - - - - - - - - -}
  84.     Var
  85.       SaveRegs                      : regtype;
  86.       HalfRegs                      : halfregtype absolute regs;
  87.       Terminate_flag                : boolean ;
  88.       Keychr                        : char ;
  89.       Old_Xpos,Old_Ypos             : integer ;
  90. { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  91.  
  92. { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  93. {  Check Terminate Keys
  94. { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  95. Procedure Chk_Term_Key;
  96. {$I StayXit.Inc}                   {Check for Exit to Dos                     }
  97. {-----------------------------------------------------------------------------}
  98. {            G  E  T  F  I  L  E                                              }
  99. {-----------------------------------------------------------------------------}
  100.  
  101. procedure get_file;
  102. {$I staysubs.inc}
  103. var
  104.   attribyte,
  105.   OldAttribute : byte;
  106.   Xcursor      : integer ;
  107.   Ycursor      : integer ;
  108. {----------------------------------------------------------------------------}
  109. begin
  110.  
  111.       filename := '*.*' ;
  112.       attribyte := 255 ;
  113.       OldAttribute := attribyte;
  114.  
  115.               Xcursor := 2 ;
  116.               Ycursor := 1 ;
  117.               GotoXy(Xcursor,Ycursor) ;
  118.  
  119.           Find_First(attribyte,filename,Retcode);
  120.               If Retcode = 0 then
  121.                  begin
  122.                  write(Filename);
  123.                  Ycursor := Ycursor +1 ;
  124.                  end;
  125.           {Now we repeat Find_Next until an error occurs }
  126.  
  127.               repeat
  128.                 Find_Next(attribyte,filename,Retcode);
  129.                 if Retcode = 0 then
  130.                  begin
  131.                         GotoXY(Xcursor,Ycursor);
  132.                         Write(filename) ;
  133.                         Ycursor := Ycursor + 1 ;
  134.  
  135.                         if WhereY >= 14 then
  136.                         begin
  137.                         Xcursor := Xcursor + 16 ;
  138.                         Ycursor := 1 ;
  139.                         end;
  140.  
  141.                         if (Xcursor >= 50) and (Ycursor = 13 ) then
  142.                         begin
  143.                         Ycursor := Ycursor + 1;
  144.                         GotoXY(Xcursor,Ycursor);
  145.                         Write ('More...');
  146.                         read ;
  147.                         clrscr ;
  148.                         Xcursor := 2 ;
  149.                         Ycursor := 1 ;
  150.                         end;
  151.                  end;
  152.                until Retcode <> 0;
  153.  
  154.                GotoXY(Xcursor,Ycursor); Write('Press a key . . .');
  155.                repeat until keypressed ;
  156.                Chk_Term_Key ;          { See if Return to Dos }
  157. end;
  158.  
  159. {-----------------------------------------------------------------------------}
  160. {        D   E  M  O                                                          }
  161. {-----------------------------------------------------------------------------}
  162. Procedure Demo ;                   { Give Demonstration of Code               }
  163.  
  164. {$I WINDMNGR.INC}
  165.  
  166. begin
  167.  
  168.      Add_Window(5,5,75,20,11,0,2);
  169.  
  170.      Get_file;
  171.  
  172.      Remove(1);
  173.  
  174. end; { Demo }
  175.  
  176.  
  177. {----------------------------------------------------------------------------}
  178. {              P R O C E S S   I N T E R R U P T                             }
  179. { - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
  180. Procedure Process_Intr;
  181.  
  182. {  PURPOSE:  This  procedure  replaces  the  standard  keyboard  interrupt.  If
  183.             anything but <Alt>-F10 is pressed,  the key is  passed  on  to  the
  184.             standard  keyboard  interrupt.  B*U*T  when  <Alt>- F10 is pressed,
  185.             this program takes over.  The variable InUse  is  set  to  TRUE  to
  186.             ensure that this code doesn't try to run "on top of itself " AND to
  187.             indicate  to the Inline code to save/restore the original interrupt
  188.             regs.
  189. }
  190.  
  191. Begin
  192.           { K e y b o a r d    Interrupt   o c c u r s   here }
  193. {----------------------------------------------------------------------}
  194. {$I Staysave.inc}
  195. {----------------------------------------------------------------------}
  196. { Check the Int 16 request function in Ah reg:
  197.                    0 = read character from Keyboard
  198.                    1 = check character available
  199.                    2 = check shift key values
  200. }
  201. if HalfRegs.Ah <> 0 then  {if this is not character request...}
  202.    Begin
  203.    Intr(User_Int,Regs)    { just pass it on to standard interrupt }
  204.    End
  205.  
  206. Else      { HalfRegs.Ah = 0 then    { This is a Character Request }
  207.   Begin   {Get Keyboard Char }
  208.  
  209.   Intr (User_Int, Regs);             { Use the standard interrupt}
  210.  
  211.   if (Halfregs.Ah = Our_Char)        { Separate the test so code }
  212.                                      { performs efficiently      }
  213.      then if  (not InUse) then
  214.  
  215.      begin { Demo }
  216.      InUse := true;                  { "dont clobber saved stack"}
  217. {            .
  218.              .
  219.              .  Your
  220.              .      Program
  221.              .             Goes
  222.              .                 Here
  223.              .
  224. }                                    { Get current Cursor Position    }
  225.      Old_Xpos := WhereX; Old_Ypos := WhereY;
  226.      Demo ;
  227.      GotoXY(Old_Xpos,Old_Ypos);       { Put Cursor Back                }
  228.      Regs.Ax := Ord(KeyChr) shl 8 ;        {Give back Last entered char     }
  229.      InUse := false;                  { ok to restore interrupted stack }
  230.      end  { Demo }
  231.  
  232.   end; {Get Keyboard Char }
  233.  
  234. {$I Stayrstr.inc}                      { Return to Caller }
  235. end ;
  236. {-----------------------------------------------------------------------}
  237.  
  238. {The main program installs the new interrupt routine and makes it permanently
  239.  resident as the keyboard interrupt.  The old keyboard interrupt is addressed
  240.  through #68H, so it can still be used.
  241.  
  242. The following dos calls are used:
  243.  
  244.  Function 25 - Install interrupt address
  245.                input al = int number,
  246.                ds:dx = address to install
  247.  
  248.  Function 35 - get interrupt address
  249.                input al = int number
  250.                output es:bx = address in interrupt
  251.  
  252.  Function 31 - terminate and stay resident
  253.                input dx = size of resident program obtained from the memory
  254.                allocation block at [Cs:0 - $10 + 3]
  255.  
  256.  Function 49 - Free Allocated Memory
  257.                input Es = Block Segment to free
  258.  
  259.  Interrupt 20 - Return to invoking process
  260. }
  261.  
  262. {-----------M A I N    B L O C K---------------------------------------------}
  263. Begin                                  {**main**}
  264.  
  265.   InUse  := false;
  266.   OurDseg:= Dseg;       { Save the Data Segment Address for Interrupts }
  267.   OurSseg:= Sseg;       { Save our Stack Segment for Interrupts        }
  268.  
  269.   Terminate_Flag := false ;
  270.  
  271.   {now install the interrupt routine}
  272.  
  273.   SaveRegs.Ax := $35 shl 8 + User_Int;
  274.   Intr($21,SaveRegs);                 {Check to make sure int not already used}
  275.  
  276.   if SaveRegs.Es <> $00 then
  277.     WriteLn ('Interrupt in use -- can''t install Resident Turbo Code')
  278.   else
  279.     begin
  280.  
  281.       { Initialize Your Progam Here since you wont get control again
  282.         until "Our_Char" is entered from the Keyboard.               }
  283.  
  284.       SaveRegs.Ax := $35 shl 8 + Kybrd_Int;
  285.       Intr($21,SaveRegs);        {get the address of keyboard interrupt }
  286.  
  287.       SaveRegs.Ax := $25 shl 8 + User_Int;
  288.       SaveRegs.Ds := SaveRegs.Es;
  289.       SaveRegs.Dx := SaveRegs.Bx;
  290.       Intr($21,SaveRegs);         { set the user-interrupt address to point
  291.                                 { to the keyboard interrupt address }
  292.  
  293.       SaveRegs.Ax := $25 shl 8 + Kybrd_Int;
  294.       SaveRegs.Ds := Cseg;
  295.       SaveRegs.Dx := Ofs(Process_Intr);
  296.       Intr ($21,SaveRegs);        { set the keyboard interrupt to point to
  297.                                   "Process-Intr" above}
  298.  
  299.       Writeln('  Turbo Stay-Resident Demo: Press Alt-F10');
  300.  
  301.       {now terminate and stay resident}
  302.                                               { Pass return code of zero    }
  303.       SaveRegs.Ax := $31 shl 8 + 0 ;          { Terminate and Stay Resident }
  304.       SaveRegs.Dx := MemW [Cseg-1:0003] ;     { Prog_Size from Allocation Blk}
  305.       Intr ($21,SaveRegs);
  306.  
  307.     end;
  308.        { END OF RESIDENCY CODE }
  309. end.
  310. {****************************************************************************}
  311. {                 S  T  A  Y  S  A  V  E  .  I  N  C                         }
  312. {                                                                            }
  313. {           This is the Staysave.Inc file included above                     }
  314. {                                                                            }
  315. {      Separate the code out into a file or replace the $I Staysave.Inc      }
  316. {                statement above with this code.                             }
  317. {****************************************************************************}
  318.  
  319. {This Inline routine will save the regs and Stack for Stay resident programs.
  320.  It restores Ds and Ss from the previously saved integer constants "OurDseg"
  321.   and "OurSSeg". This is important since Dos is not re-entrant and any attempt
  322.   to use Interrupt I/O services will clobber the very stack on which the
  323.   Resident Turbo program just saved its regs. Thus, on the final return, you
  324.   and Toto will end up somewhere other than Kansas and without your Ruby Reds.
  325.    }
  326.  
  327. { Arthor:      L.H. Ferris
  328.  
  329.        Distributed to the Public Domain for use without profit.
  330.                     Original Version 5.15.85
  331. }
  332.                                    { On entry the Stack will already contain: }
  333.                                    {  1) Sp for Dos                           }
  334.                                    {  2) Bp for Dos                           }
  335.                                    {  3) Ip for Dos                           }
  336.                                    {  4) Cs for Dos                           }
  337.   Inline (                         {  5) Flags for Dos                        }
  338.  
  339.  
  340.  
  341.     $FA /                              {  Cli       Stop all interrupts       }
  342.  
  343.                                        { Bp and Sp aready saved at Begin Stmt }
  344.     $55/                               {Push   Bp  Save again for Regpak      }
  345.     $BD/Regs/                          {Mov    Bp,offset REGS}
  346.     $2E/$89/$46/$00/                   {CS:Mov [Bp+0],AX}
  347.     $2E/$89/$5E/$02/                   {Cs:Mov [Bp+2],Bx}
  348.     $2E/$89/$4E/$04/                   {CS:Mov [Bp+4],CX}
  349.     $2E/$89/$56/$06/                   {CS:Mov [Bp+6],DX}
  350.     $2E/$8F/$46/$08/                   {Pop    Cs:[Bp+8] Fetch Bp from stack  }
  351.     $2E/$89/$76/$0A/                   {CS:Mov [Bp+A],SI}
  352.     $2E/$89/$7E/$0C/                   {CS:Mov [Bp+C],DI}
  353.     $2E/$8C/$5E/$0E/                   {CS:Mov [Bp+E],DS}
  354.     $2E/$8C/$46/$10/                   {CS:Mov [Bp+10],ES}
  355.     $9C/                               {PUSHF  put Flags on stack to retrieve }
  356.     $2E/$8F/$46/$12/                   {POP Cs:[Bp+12]}
  357.  
  358.     { If Current SS := [OurSseg] or Inuse = True, then dont save the stack. }
  359.     { This program is being recursive.                                      }
  360.  
  361.      $2E/$80/$3E/Inuse/$01/   {Cmp  Cs:[Inuse],1                          }
  362.      $74/$4D/                 {Je   ReCurin ------J-U-M-P---------------  }
  363.  
  364.     { Now save 5 Words from the Dos Stack before performing any         }
  365.     { I/O or re-using the Dos stack                                     }
  366.  
  367.      $2E/$8C/$16/DosSSeg/     {Mov  Cs:DosSSeg,SS Save Dos Stack Segment    }
  368.      $8C/$D6/                 {Mov  Si,SS         If this is our Stack Seg  }
  369.      $8E/$C6/                 {Mov  Es,Si         Get Dos StackSeg          }
  370.      $2E/$8E/$16/OurSSeg/     {Mov  SS,Cs:OurSSeg Get our Stack segment     }
  371.      $2E/$8E/$1E/OurDseg/     {Mov  Ds,Cs:Our_Ds  Setup our Data Segment    }
  372.  
  373.  
  374.      $2E/$3B/$36/OurSSeg/     {Cmp  Si,Cs:OurSSeg ..use current Stack ptr   }
  375.      $89/$E6/                 {Mov  Si,Sp         ..value..else reset stack }
  376.      $74/$05/                 {Je   $+5           ..to original Turbo stack }
  377.      $3E/$8B/$36/$74/$01/     {Mov  Si,Ds:[174]   ..(cf. code at B2B 3.0x)  }
  378.  
  379.      $87/$F4/                 {Xchg Sp,Si         Set new  Stack Pointer    }
  380.  
  381.      $2E/$FF/$76/$00/         {Push [Bp+0]  Save Dos/User regs for Exit     }
  382.      $2E/$FF/$76/$02/         {Push [Bp+2]  Save Bx                         }
  383.      $2E/$FF/$76/$04/         {Push [Bp+4]  Save Cx                         }
  384.      $2E/$FF/$76/$06/         {Push [Bp+6]  Save Dx                         }
  385.                               {Push [Bp+8]  Save Bp                         }
  386.      $2E/$FF/$76/$0A/         {Push [Bp+A]  Save Si                         }
  387.      $2E/$FF/$76/$0C/         {Push [Bp+C]  Save Di                         }
  388.      $2E/$FF/$76/$0E/         {Push [Bp+E]  Save Ds                         }
  389.      $2E/$FF/$76/$10/         {Push [Bp+10] Save Es                         }
  390.  
  391.  
  392.      $2E/$8E/$16/OurSSeg/     {Mov  SS,Cs:OurSSeg Set up our Stack          }
  393.      $56/                     {Push Si            Save bottom of Dos Stack  }
  394.      $2E/$8C/$5E/$0E/         {Mov  Cs:[Bp+E],Ds  Set New Data Segmt in regs}
  395. {Recurin                                            Jump here if Recursion  }
  396.      $FB                      {Sti Enable Interrupts                        }
  397.  
  398.        ) ;
  399. {****************************************************************************}
  400. {                  S  T  A  Y  R  S  T  R  .  I  N  C                        }
  401. {                                                                            }
  402. {           This is the StayRstr.Inc file included above                     }
  403. {       Separate the code out into a file or replace the $I StayRstr.Inc     }
  404. {                  statement above with this code.                           }
  405. {****************************************************************************}
  406.  
  407. { Inline Code to restore the stack and regs moved to the Turbo Resident
  408.   Program Stack to allow re-entrancy into the Dos Code for I/O and
  409.   recursion from built-in Turbo functions.
  410.  
  411. ; Arthor:      L.H. Ferris
  412.  
  413. ; Distributed to the Public Domain for use without profit.
  414. ; Original Version 5.15.85
  415.  
  416. ;----------------------------------------------------------------------;
  417. ;        Restore the Dos Regs and Stack
  418. ;----------------------------------------------------------------------;
  419.  
  420. ; On entry the Stack will already contain:
  421. ;
  422. ;        1) Bottom of Dos Stack Ptr
  423. ;        2) Dos Flags
  424. ;        3) Dos Code Segment
  425. ;        4) Dos Instruction Ptr
  426. ;        5) Dos Base Pointer
  427. ;        6) Dos Original Stack Ptr
  428. }
  429.     inline(
  430.  
  431.     $BD/Regs/                          {Mov    Bp,offset REGS}
  432.     $2E/$8B/$46/$00/                   {CS:Mov Ax,[Bp+0]}
  433.     $2E/$8B/$5E/$02/                   {Cs:Mov Bx,[Bp+2]}
  434.     $2E/$8B/$4E/$04/                   {CS:Mov Cx,[Bp+4]}
  435.     $2E/$8B/$56/$06/                   {CS:Mov Dx,[Bp+6]}
  436.  
  437.     $2E/$8B/$76/$0A/                   {CS:Mov Si,[Bp+A]}
  438.     $2E/$8B/$7E/$0C/                   {CS:Mov Di,[Bp+C]}
  439.     $2E/$8E/$5E/$0E/                   {CS:Mov DS,[Bp+E]}
  440.     $2E/$8E/$46/$10/                   {CS:Mov ES,[Bp+10]}
  441.     $2E/$FF/$76/$12/                   {Push Cs:[Bp+12]}
  442.     $9D/                               {Popf}
  443.  
  444.     { If [Cs:InUse]:= True,  then dont restore the stack. This program is   }
  445.     { being recursive. Else restore  Dos Stack and Program Entry registers  }
  446.  
  447.      $2E/$80/$3E/Inuse/$01/   {Cmp  byte ptr Cs:[Inuse],1                   }
  448.      $74/$12/                 {Je   ReCurOut                                }
  449.  
  450.       $FA /                   { Cli      ; Stop all interrupts    }
  451.  
  452.  
  453.     $5D/                     {Pop Bp           Save Dos Sp across pops   }
  454.  
  455.     $07/                     {Pop  Es                                     }
  456.     $1F/                     {Pop  Ds                                     }
  457.     $5F/                     {Pop  Di                                     }
  458.     $5E/                     {Pop  Si                                     }
  459.     $5A/                     {Pop  Dx                                     }
  460.     $59/                     {Pop  Cx                                     }
  461.     $5B/                     {Pop  Bx                                     }
  462.     $44/$44/                 {Inc sp/Inc sp Thow old Ax value away        }
  463.  
  464.     $89/$EC/                  {Mov  Sp,Bp         Setup Dos Stack Ptr      }
  465.     $2E/$8E/$16/DosSSeg/      {Mov  SS,Cs:DosSSeg Give back Dos Stack      }
  466.  
  467. {RecurOut                              Clean up the Stack              }
  468.  
  469.     $5D/                               {Pop Bp  Throw away old dos Sp  }
  470.  
  471.     $BD/Regs/                          {Mov    Bp,offset REGS}
  472.     $2E/$FF/$76/$12/                   {Push Cs:[Bp+12]}
  473.     $9D/                               {Popf}
  474.     $5D/                               {Pop Bp  Retrieve old BP        }
  475.  
  476.     $FB/                               {Sti     Enable interrupts      }
  477.     $CA/$02/$00                        {Ret Far 002                    }
  478.         );
  479.  
  480. {****************************************************************************}
  481. {                         S T A Y S U B S  .  I N C                          }
  482. {                                                                            }
  483. {   Separate this file into "Staysubs.Inc" to provide Directory routines     }
  484. {       for the Stay-Resident Demo.                                          }
  485. {                                                                            }
  486. {****************************************************************************}
  487.  
  488.  
  489. {----------------------------------------------------------------------------}
  490. {                  F I L E         S U B R O U T I N E S                     }
  491. {----------------------------------------------------------------------------}
  492.   type
  493.     Dir_Entry   = record
  494.                       Reserved : array[1..21] of byte;
  495.                       Attribute: byte;
  496.                       Time, Date, FileSizeLo, FileSizeHi : integer;
  497.                       Name : string[13];
  498.                     end;
  499.   var
  500.     RetCode     : byte;
  501.     Filename  : filename_type;
  502.     Buffer    : Dir_Entry;
  503.     Attribute : byte;
  504. {----------------------------------------------------------------------------}
  505. {                S  E  T       Disk  Transfer  Address                       }
  506. {----------------------------------------------------------------------------}
  507. Procedure Disk_Trns_Addr(var Disk_Buf);
  508. var
  509.   Registers : regtype;
  510. Begin
  511.   with Registers do
  512.     begin
  513.       Ax := $1A shl 8;                 { Set disk transfer address to  }
  514.       Ds := seg(Disk_Buf);             { our disk buffer               }
  515.       Dx := ofs(Disk_Buf);
  516.       msdos(Registers);
  517.     end;
  518. end;
  519. {----------------------------------------------------------------------------}
  520. {                  F I N D   N E X T   F I L E   E N T R Y                   }
  521. {----------------------------------------------------------------------------}
  522. Procedure Find_Next(var Att:byte; var Filename : Filename_type;
  523.                                       var Next_RetCode : byte);
  524. var
  525.   Registers  : regtype;
  526.   Carry_flag : integer;
  527.   N          : byte;
  528.  
  529. Begin  {Find_Next}
  530.   Buffer.Name := '             ';     { Clear result buffer }
  531.   with Registers do
  532.       begin
  533.       Ax := $4F shl 8;                 { Dos Find next function }
  534.       MsDos(Registers);
  535.       Att := Buffer.Attribute;         { Set file attribute     }
  536.       Carry_flag := 1 and Flags;       { Isolate the Error flag }
  537.       Filename := '             ';
  538.       if Carry_flag = 1 then
  539.         Next_RetCode := Ax and $00FF
  540.       else
  541.         begin                          { Move file name         }
  542.         Next_RetCode := 0;
  543.         for N := 0 to 12 do FileName[N+1] := Buffer.Name[N];
  544.         end;
  545.     end;  {with}
  546. end;
  547. {----------------------------------------------------------------------------}
  548. {              F I N D   F I R S T   F I L E   F U N C T I O N               }
  549. {----------------------------------------------------------------------------}
  550. Procedure Find_First (var Att: byte;
  551.                       var Filename: Filename_type;
  552.                       var RetCode_code : byte);
  553.  
  554.   var
  555.       Registers        :regtype;
  556.       Carry_flag       :integer;
  557.       Mask, N          :byte;
  558.  
  559.   begin
  560.     Disk_Trns_Addr(buffer);
  561.     Filename[length(Filename) + 1] := chr(0);
  562.     Buffer.Name := '             ';
  563.     with Registers do
  564.       begin
  565.       Ax := $4E shl 8;                  { Dos Find First Function }
  566.       Cx := Att;                        { Attribute of file to fine }
  567.       Ds := seg(Filename);              { Ds:Dx Asciiz string to find }
  568.       Dx := ofs(Filename) + 1;
  569.       MsDos(Registers);
  570.       Att := Buffer.Attribute;          { set the file attribute byte  }
  571.  
  572.         { If error occured set, Return code. }
  573.  
  574.         Carry_flag := 1 and Flags;      { If Carry flag, error occured }
  575.                                         { and Ax will contain Return code }
  576.         if Carry_flag = 1 then
  577.           begin
  578.           RetCode_code := Ax and $00FF;
  579.           end
  580.  
  581.         else
  582.           begin
  583.           RetCode_code := 0;
  584.           Filename := '             ';
  585.           for N := 0 to 12 do FileName[N+1] := Buffer.Name[N];
  586.           end;
  587.  
  588.       end;  {with}
  589. end;
  590. {****************************************************************************}
  591. {                       S T A Y X I T   .   I N C                            }
  592. {                                                                            }
  593. {     Separate this file into "StayXIT.Inc" to provide a "Go-non-Resident"   }
  594. {                   routine or the Stay-Resident Demo.                       }
  595. {                                                                            }
  596. {****************************************************************************}
  597.  
  598. {-----------------------------------------------------------------------------}
  599. {  Stay_Xit Check Terminate Keys                                              }
  600. {                                                                             }
  601. {  Check for Ctrl_Home key. Free the Environment , the program segment        }
  602. {  memory and return to Dos. Programs using this routine ,must be the         }
  603. {  last program in memory, else ,a hole will be left causing Dos              }
  604. {  to go GooGoo .                                                             }
  605. {-----------------------------------------------------------------------------}
  606.  
  607.    Begin { Block }
  608.       if Keypressed then
  609.          Begin { Keypressed }
  610.          While Keypressed do read (Kbd,Keychr);
  611.          If Keychr = Quit_Key then
  612.             Begin { Terminate }
  613.             Writeln ('Stay-Resident program Terminating') ;
  614.             SaveRegs.Ax := $35 shl 8 + User_Int;
  615.             MsDos(SaveRegs);           {get the original Int 16 Addr   }
  616.  
  617.             SaveRegs.Ax := $25 shl 8 + Kybrd_Int;
  618.             SaveRegs.Ds := SaveRegs.Es;
  619.             SaveRegs.Dx := SaveRegs.Bx; { set the user-interrupt address to }
  620.             MsDos(SaveRegs);            { the keyboard interrupt address    }
  621.  
  622.             MemW[$00:User_Int * 4] := 0 ; { Clear User Interrupt vector     }
  623.             MemW[$00:User_Int * 4 + 2] :=0;
  624.  
  625.             Saveregs.Ax := $49 shl 8 + 0 ;    { Free Allocated Block function}
  626.             Saveregs.Es := MemW[Cseg:$2C] ; { Free environment block       }
  627.             MsDos( Saveregs ) ;
  628.  
  629.             Saveregs.Ax := $49 shl 8 + 0 ;    { Free Allocated Block function}
  630.             Saveregs.Es := Cseg ;             { Free Program                 }
  631.             MsDos( Saveregs ) ;
  632.  
  633.             Intr($20,Regs) ;           { Return to Dos }
  634.  
  635.             End   { Terminate } ;
  636.          End  { Keypressed };
  637.    End  { Block };
  638. {****************************************************************************}
  639. {                       W I N D M N G R    .   I N C                         }
  640. {                                                                            }
  641. {     Separate this file into "WindMngr.Inc" to provide a Window for         }
  642. {                    the Stay-Resident Demo.                                 }
  643. {                                                                            }
  644. {****************************************************************************}
  645.             { Window Manager/Editor System Include file .. }
  646. { Author:
  647.           
  648.            Jim Everingham (The Window Manager/Editor)                        }
  649.           
  650.  
  651. Const
  652.       MaxScreens = 8;     { Number of Windows Allowed, do not Change }
  653.       Screen_seg = $B800; { Change to #B000 for MonoChrome, Change
  654.                             then # sign to a Dollar sign Though. }
  655.       Data_Addr = $0000;
  656.       Fc        : Array[1..4, 1..7] of Integer
  657.                 = ((218, 196, 191, 179, 192, 196, 217),
  658.                    (201, 205, 187, 186, 200, 205, 188),
  659.                    (213, 205, 184, 179, 212, 205, 190),
  660.                    (219, 219, 219, 219, 219, 219, 219));
  661.  
  662. type maxstr     = string[80];
  663.      window_rec = record
  664.                         x1,x2,y1,y2,c1,b1,w1,w2: Integer;
  665.                         Screen: Array[1..4000] of byte;
  666.                   end;
  667.  
  668. var  Stack_Top,Last_Window_Num,
  669.      line_pos,F1         : Integer;
  670.      screen              : Array[1..4000] of byte;
  671.      real_screen         : Array[1..4000] of byte absolute Screen_Seg:Data_Addr;
  672.      Page_1              : Array[1..4000] of byte absolute Screen_Seg:$1000;
  673.      Imig                : Array [1..MaxScreens] of Window_rec;
  674.      Original            : Array[1..4000] of byte;
  675.      Coords              : Array[1..8,1..MaxScreens] of Integer;
  676.  
  677.  
  678. {----------------------------------------------------------------------------}
  679. {                              S E T _ P A G E                               }
  680. {----------------------------------------------------------------------------}
  681. procedure set_page(page: byte);
  682.  
  683. type
  684.   Result =
  685.     record
  686.       AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags: byte;
  687.     end;
  688. var rec:result;
  689.  
  690. begin
  691.   Rec.AX := page;
  692.   Rec.BX := $05;
  693.   Intr($10,Rec);
  694. end;
  695.  
  696. {----------------------------------------------------------------------------}
  697. {                        S  C  R  N  _  O  F  F                              }
  698. {----------------------------------------------------------------------------}
  699. Procedure Scrn_off;
  700. begin
  701.      inline($52/$50/$ba/$d8/$03/$b0/$21/$ee/$58/$5a)
  702. end;
  703. {----------------------------------------------------------------------------}
  704. {                        S  C  R  N  _  O  N                                 }
  705. {----------------------------------------------------------------------------}
  706. Procedure Scrn_on;
  707. begin
  708.      inline($52/$50/$ba/$d8/$03/$b0/$29/$ee/$58/$5a)
  709. end;
  710. {----------------------------------------------------------------------------}
  711. {                        A  C  T  I  V  E                                    }
  712. {----------------------------------------------------------------------------}
  713. Function active: integer;
  714. begin
  715.      active:=stack_top
  716. end;
  717. {----------------------------------------------------------------------------}
  718. {                              P  U  S  H                                    }
  719. {----------------------------------------------------------------------------}
  720. Procedure Push(Ulx, Uly, Lrx, Lry, Foreground, Background: integer);
  721.  
  722. { This procedure Saves screens in memory. When a new window is put
  723.   on the Screen, the preceding window is stored away for later reference.}
  724.  
  725. begin
  726.      { If last Window up, move the Original Screen into Screen Memory}
  727.      if stack_top = 0 then
  728.            begin
  729.               Scrn_off;
  730.               move(real_screen, Original, 4000);
  731.               Scrn_on
  732.            end;
  733.      {Save all Data concerning the windows}
  734.      if (Stack_top < MaxScreens) and (Stack_Top >= 0) then
  735.             begin
  736.                  Stack_top:=Stack_top+1;
  737.                  Imig[Stack_top].x1:=Ulx;
  738.                  Imig[Stack_top].y1:=Uly;
  739.                  Imig[Stack_top].x2:=Lrx;
  740.                  Imig[Stack_top].y2:=Lry;
  741.                  Imig[stack_top].c1:=Foreground;
  742.                  Imig[Stack_top].b1:=Background
  743.             end;
  744.  
  745.      { Push Screen on Stack ... Sort of... }
  746.      Scrn_off;
  747.      Move(real_screen,Imig[Stack_top].Screen,4000);
  748.      Scrn_on
  749. end;
  750. {----------------------------------------------------------------------------}
  751. {                              P  O  P                                       }
  752. {----------------------------------------------------------------------------}
  753. Procedure Pop;
  754.  
  755. { This Procedure takes the screen that procedes the current window and
  756.   Copies back to screen memory, restores all data concerning the previous
  757.   window and activates it.. Neat huh? }
  758.  
  759. begin
  760.  
  761.      { If no windows are active, save the current screen }
  762.      if stack_top =0 then
  763.            begin
  764.                 normvideo;
  765.                 window(1,1,80,25);
  766.                 Scrn_off;
  767.                 move(Original, real_screen, 4000);
  768.                 Scrn_on;
  769.            end;
  770.  
  771.      { Get Preceding screen and copy it to screen memory }
  772.      Scrn_off;
  773.      Move(Imig[Stack_top].Screen,Real_Screen,4000);
  774.      Scrn_on;
  775.      Stack_top:=Stack_top-1
  776. end;
  777. {----------------------------------------------------------------------------}
  778. {                           W  R  I  T  E  X  Y                              }
  779. {----------------------------------------------------------------------------}
  780. Procedure Writexy(long_string:maxstr; xcoord,ycoord:integer; var color: integer);
  781.  
  782. { This procedure Draws whatever you want, wherever you want, by changing the
  783.   value of Screen in the variable declaration, it can draw a "Picture" any-
  784.   were in memory. This allows for the Speed of the window making process..}
  785.  
  786. var str_len, real_pos, scr_pos: integer;
  787.  
  788. begin
  789. {$I-}
  790.      str_len:=length(long_string); { So I know how much to write }
  791.      Scr_pos:=0;
  792.  
  793.      { The next 8 lines write the string in every "even" location in memory
  794.        and ever odd location gets the attribute with determines how the
  795.        string is displayed on the screen}
  796.      for real_pos:=1 to str_len do
  797.                  if scr_pos < 4001 then
  798.                        begin
  799.                             scr_pos:=((xcoord*2)-1)+(ycoord*160);
  800.                             screen[scr_pos]:=ord(copy(long_string,real_pos,1));
  801.                             screen[scr_pos+1]:=color;
  802.                             xcoord:=xcoord+1;
  803.                        end
  804. {$I+}
  805. end;
  806.  
  807. {----------------------------------------------------------------------------}
  808. {                              F  R  A  M  E                                 }
  809. {----------------------------------------------------------------------------}
  810. Procedure Frame(WindowType, UpperLeftX, UpperLeftY, LowerRightX, LowerRightY, color: Integer);
  811.  
  812. { This procedure draws the window frame in another part of memory. }
  813. var i: integer;
  814. begin
  815.      WriteXY(chr(Fc[WindowType,1]),UpperLeftX, UpperLeftY,color);
  816.      for i:=UpperLeftX+1 to LowerRightX-1 do WriteXY(chr(Fc[WindowType,2]),i,UpperleftY,color);
  817.      WriteXY(chr(Fc[WindowType,3]),i+1,UpperleftY,color);
  818.      for i:=UpperLeftY+1 to LowerRightY-1 do
  819.          begin
  820.               WriteXY(chr(Fc[WindowType,4]),UpperLeftX , i,color);
  821.               WriteXY(chr(Fc[WindowType,4]),LowerRightX, i,color);
  822.          end;
  823.      WriteXY(chr(Fc[WindowType,5]),UpperLeftX, LowerRightY, color);
  824.      for i:=UpperLeftX+1 to LowerRightX-1 do WriteXY(chr(Fc[WindowType,6]),i,LowerrightY,color);
  825.      WriteXY(chr(Fc[WindowType,7]),i+1,LowerRightY,color);
  826. end  { Frame };
  827. {----------------------------------------------------------------------------}
  828. {                         I  N  I  T  I  A  L  I  Z  E                       }
  829. {----------------------------------------------------------------------------}
  830. Procedure initialize;
  831.  
  832. { Set up memory and the stack }
  833.  
  834. var i:integer;
  835.  
  836. begin
  837.      Stack_top:=0;
  838.      move(real_screen,screen,4000);
  839.      with imig[1] do for i:=1 to 4000 do screen[i]:=$00;
  840.      for i:=2 to 9 do move(Imig[i-1].screen,imig[i].screen,4000);
  841.      move(imig[1].screen,screen,4000);
  842.      move(imig[1].screen,original,4000)
  843. end;
  844. {----------------------------------------------------------------------------}
  845. {                    A  D  D  _  W  I  N  D  O  W                            }
  846. {----------------------------------------------------------------------------}
  847. Procedure Add_window(UpperLeftX,UpperLeftY,LowerRightX,LowerRightY,Foreground,
  848.                  BackGround, WindowType: Integer);
  849.  
  850. { This procedure does all the laborous work for you.. The variables make it
  851.   Fairly easy to understand. }
  852.  
  853. Var i,j,k,Color: Integer;
  854.  
  855. begin
  856.      Imig[Stack_top].w1:=whereX;
  857.      Imig[Stack_top].w2:=WhereY;
  858.      UpperLeftX:=UpperLeftX+1;
  859.      LowerRightX:=LowerRightX-1;
  860.      LowerRightY:=LowerRightY-2;
  861.      f1:=WindowType;color:=0;
  862.      Scrn_off;
  863.      move(real_screen,screen,4000);
  864.      Scrn_on;
  865.  
  866.      { Set color attribute for direct writeng to memory }
  867.      if background < 17 then Color:=foreground+(background*16);
  868.  
  869.      { Check for invalid window frame types }
  870.      if (WindowType > 5) or (WindowType < 0) then
  871.               begin
  872.                    Clrscr;
  873.                    Writeln('Invalid Frame Type!')
  874.               end
  875.     else
  876.  
  877.      { If the window is valid then Procede }
  878.               begin
  879.  
  880.      { Fill color Attribute of window directly into memory }
  881.                    k:=1;
  882.                    for j:=UpperLeftY to LowerRightY do
  883.                            for i:=UpperLeftX to LowerRightX do
  884.                                     begin
  885.                                          k:=(j*160)+(i*2);
  886.                                          Screen[k]:=Color;
  887.                                          Screen[k-1]:=$20
  888.                                     end;
  889.  
  890.     { Frame Window }
  891.                    Case Windowtype of
  892.                              1:Frame(WindowType,UpperLeftX-1,UpperLeftY-1,
  893.                                       LowerRightX+1,LowerRightY+1,
  894.                                       color);
  895.                              2:Frame(WindowType,UpperLeftX-1,UpperLeftY-1,
  896.                                       LowerRightX+1,LowerRightY+1,
  897.                                       color);
  898.                              3:Frame(WindowType,UpperLeftX-1,UpperLeftY-1,
  899.                                            LowerRightX+1,LowerRightY+1,
  900.                                            color);
  901.                              4:Frame(WindowType,UpperLeftX-1,UpperLeftY-1,
  902.                                       LowerRightX+1,LowerRightY+1,
  903.                                       color);
  904.                              end { Case }
  905.               end;
  906.  
  907.     { Activate newly formed window }
  908.     Window(1,1,80,25);
  909.     Window(UpperLeftX,UpperLeftY+1,LowerRightX,LowerRightY+1);
  910.     push(UpperLeftx,UpperLeftY+1,LowerRightX,LowerRightY+1,Foreground, Background);
  911.     Scrn_off;
  912.     Move(screen,real_screen,4000);gotoxy(1,1);
  913.     Scrn_on;
  914.     Textcolor(Foreground);TextBackground(backGround);ClrScr;
  915. end;
  916. {----------------------------------------------------------------------------}
  917. {                    C  O  L  O  R  _  W  I  N  D  O  W                      }
  918. {----------------------------------------------------------------------------}
  919. Procedure Color_window(Foreground, Background: integer);
  920.  
  921. { This procedure allows you to change the foreground and background color
  922.   of the active window. }
  923.  
  924. var i,j,Color: Integer;
  925.  
  926. begin
  927.  
  928.      { Set Attribute value }
  929.      if background < 8 then Color:=foreground+(background*16);
  930.  
  931.      { Write new attribute direclty to screen memory }
  932.      for j:=(Imig[Stack_top].y1-2) to Imig[Stack_top].y2 do
  933.             for i:=(Imig[Stack_top].x1-1) to (Imig[Stack_top].x2+1) do
  934.                     begin
  935.                          Real_Screen[(j*160)+(i*2)]:=Color
  936.                     end
  937. end;
  938. {----------------------------------------------------------------------------}
  939. {                        R  E  M  O  V  E                                    }
  940. {----------------------------------------------------------------------------}
  941. Procedure Remove(Num_to_Remove: Integer);
  942.  
  943. { This Procedure removes 1 or a specified number of windows from the
  944.   screen and reactivates the underlying window }
  945.  
  946. var i: integer;
  947. begin
  948.      if (Num_to_Remove > 0) and (Num_to_Remove < MaxScreens) then
  949.           for i:=1 to Num_to_remove do Pop
  950.      else
  951.          Pop;
  952.      Window(1,1,80,25);
  953.      Window(Imig[Stack_top].x1+1,Imig[Stack_top].y1,Imig[Stack_top].x2,Imig[Stack_top].y2);
  954.      gotoxy(1,1);
  955.      TextBackground(Imig[Stack_top].b1);TextColor(Imig[Stack_top].c1);
  956.      GotoXY((Imig[Stack_top].w1-1),Imig[Stack_top].w2)
  957. end;
  958. {----------------------------------------------------------------------------}
  959. {                   W  I  N  D  O  W  _  T  I  T  L  E                       }
  960. {----------------------------------------------------------------------------}
  961. Procedure Window_Title(Name: Maxstr; color:integer);
  962.  
  963. var i, k, l, m: integer;
  964.  
  965. begin
  966.      If Length(name)>0 then
  967.      begin
  968.      l:=1;
  969.      color:=color+(Imig[Stack_top].b1*16);
  970.      if f1 < 4 then Real_Screen[(((Imig[Stack_top].Y1-2)*160)+(Imig[Stack_top].X1*2))+l]:=$5b;
  971.      for i:=1 to length(Name) do
  972.              begin
  973.                   k:=(((Imig[Stack_top].Y1-2)*160)+(Imig[Stack_top].X1*2))+l+1;
  974.                   Real_Screen[k+1]:=ord(copy(Name,i,1));
  975.                   Real_Screen[k+2]:=color;
  976.                   l:=l+2
  977.              end;
  978.      if f1 < 4 then Real_Screen[k+3]:=$5d
  979.      end
  980. end;
  981.  
  982. { Thats all.. }
  983.  
  984.